home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Purity
/
Purity #22 (1994-01-19)(Diesel)(DE)[WB].zip
/
Purity #22 (1994-01-19)(Diesel)(DE)[WB].adf
/
MagicBlank
/
MagicBlank.p
< prev
next >
Wrap
Text File
|
1994-01-17
|
20KB
|
702 lines
{ ****** Auto-Revision (do NOT edit) ********************
*
* © Copyright by BOMBERSOFT
*
* Filename : MagicBlank.p
* Created on : 20.12.1993
* Created by : Björn Schotte
* Current revision : V1.41
*
*
* Purpose: Allround-Utility (Hauptfunktion: Blanking)
*
*
* V1.41 : 20.12.1993 : CLI-Interface hinzugefügt. Ab
* Version 1.5 wird dann ein
* extra Prefs-Programm
* hinzukommen, mit dem sich die
* Einstellungen komfortabel
* verwalten lassen =8)
*
* V1.400 : 17.11.1993 : - Initial release -
******************************************************* }
USES ExecIO, Exec, Custom, Intuition, Graphics;
LABEL weiter;
{$opt b-,q;
incl "exec/interrupts.h",
"devices/input.h",
"devices/inputevent.h",
"intuition/intuitionbase.h",
"CLI.i",
"libraries/dos.h"}
CONST
ver = "$VER: MagicBlank V1.40 (13.11.1993)";
COM_EDIT = -1;
COM_UHR = -2;
portname = "MagicBlank-Port";
SBF_C = SIGBREAKF_CTRL_C;
SBF_D = SIGBREAKF_CTRL_D;
SBF_E = SIGBREAKF_CTRL_E;
SBF_F = SIGBREAKF_CTRL_F;
SBF_CF= SIGBREAKF_CTRL_C OR SIGBREAKF_CTRL_F;
configname = ":s/MagicBlank.cfg"; { Konfigdatei }
configID = "MagicBlank-Konfigurationsdatei";
TYPE
CodeTyp = Array[1..15] of Word;
{ Positionen der Sterne plus "Geschwindigkeit": }
StarPos = RECORD
x,y : Integer;
speedx : Integer;
END;
VAR
Arg : ARRAY[1..10] OF STRING[80];
MouseTime,MTime : LONG;
port : p_MsgPort;
ioreq : ^IOStdReq;
inter : Interrupt;
err : BYTE;
ThisTask : p_Task;
Sig, SigBit,
ScreenTime,
zähler,
prio,
MouseFactor,
sig1 : LONG;
_paslibbase : BYTE; IMPORT;
InterfaceCode : Codetyp;
done,
blanked,
ok,
Linkshänder,
MMBShift : BOOLEAN;
ns : NewScreen; STATIC;
sp : p_Screen; STATIC;
star : Array[1..12] Of StarPos;
i,zuf : INTEGER;
rp : p_RastPort;
f : Text;
BlankNum : 1..5;
mask, Kommando : LONG;
lpressed, shifted,
ScreenSwitcher : BOOLEAN;
IBase : p_IntuitionBase;
{*********************************************************
** MausPort setzen. **
** **
** 1 für GamePort, 0 für MausPort **
*********************************************************}
PROCEDURE ChangeMPort(VAR ioreq:p_IOStdReq; MPort:BYTE);
VAR
p : ^BYTE;
err : INTEGER;
BEGIN
p := PTR(Addr(MPort));
ioreq^.io_Command := IND_SETMPORT;
ioreq^.io_Data := p;
ioreq^.io_Length := 1;
err := DoIO(p_IORequest(ioreq));
END;
{*********************************************************
** Schaltet die Sprites ab. **
*********************************************************}
PROCEDURE SPRITE_OFF;
BEGIN
cc.dmacon := 0 + $20;
END;
{*********************************************************
** Schaltet die Sprites ein. **
*********************************************************}
PROCEDURE SPRITE_ON;
BEGIN
cc.dmacon := $8000 + $20;
END;
{*********************************************************
** Löscht unsere Kommando-Variable. **
*********************************************************}
PROCEDURE ClearKommando;
BEGIN
Kommando := 0;
END;
{*********************************************************
** Setzt unsere Kommando-Variable. **
*********************************************************}
PROCEDURE SetKommando(com : LONG);
BEGIN
Kommando := com;
END;
{*********************************************************
** Setzt die MouseBlanker-Zeit auf ihren alten Wert zu-**
** rück. **
*********************************************************}
PROCEDURE ResetMouseTime;
BEGIN
MouseTime := MTime * 10 - 10;
END;
{*********************************************************
** Setzt die Blanker-Zeit wieder auf ihren alten Wert **
** zurück. **
*********************************************************}
PROCEDURE ResetTime;
BEGIN
zähler := ScreenTime * 10 - 10;
END;
{*********************************************************
** Beschleunigt die Maus um Faktor "Factor". **
*********************************************************}
PROCEDURE Beschleuniger(VAR ev: p_InputEvent; VAR Factor : Long);
BEGIN
ev^.ie_position.ie_xy.ie_x := ev^.ie_position.ie_xy.ie_x*Factor;
ev^.ie_position.ie_xy.ie_y := ev^.ie_position.ie_xy.ie_y*Factor;
END;
{*********************************************************
** Öffnet den Blanker-Screen. **
*********************************************************}
FUNCTION ScreenÖffnen : Boolean;
BEGIN
ns := NewScreen(0,0,320,200,3,0,1,0,CUSTOMSCREEN+SCREENQUIET,NIL,NIL,NIL,
NIL);
sp := OpenScreen(^ns);
IF sp = NIL Then
BEGIN
ScreenÖffnen := FALSE;
DisplayBeep(NIL);
END ELSE
BEGIN
ScreenÖffnen := TRUE;
rp := ^sp^.RastPort;
END;
END;
{*********************************************************
** Schliesst den evtl. geöffneten Screen. **
*********************************************************}
PROCEDURE Schliessen;
VAR
ok : BOOLEAN;
BEGIN
IF (sp<>NIL) THEN ok := CloseScreen(sp);
sp := NIL;
END;
{*********************************************************
** Blanker-MODULE integrieren. **
*********************************************************}
{$path"RAM:Pascal/MagicBlank/","Sources:MagicBlank/";
incl"STARS.h","BLACKSCR.h","LINES.h","POINTS.h"}
{*********************************************************
** Input-Device, Port etc. schliessen. **
*********************************************************}
PROCEDURE CloseInput;
BEGIN
IF ioreq^.io_Device<>NIL THEN CloseDevice(p_IORequest(ioreq));
IF ioreq<>NIL THEN DeleteStdIO(ioreq);
IF port<>NIL THEN DeletePort(port);
IF SigBit<>-1 THEN FreeSignal(SigBit);
END;
{*********************************************************
** Handler aus dem System entfernen. **
*********************************************************}
PROCEDURE RemHandler;
BEGIN
ioreq^.io_Data := ^inter;
ioreq^.io_Command := IND_REMHANDLER;
err := DoIO (p_IORequest(ioreq));
IF err <> 0 THEN
BEGIN
Schliessen;
CloseInput;
IF FromWB THEN
FOR i := 1 TO 2 DO DisplayBeep(NIL)
ELSE
BEGIN
WriteLn(#27"[1;33mFATALER FEHLER:");
WriteLn("KANN MEINEN HANDLER NICHT ENTFERNEN !!!!"#27"[0m");
END;
Halt(20);
END;
END;
{*********************************************************
** Handler ins System einbinden. **
*********************************************************}
PROCEDURE AddHandler;
BEGIN
ioreq^.io_Data := ^inter;
ioreq^.io_Command := IND_ADDHANDLER;
err := DoIO(p_IORequest(ioreq));
IF err <> 0 THEN
BEGIN
Schliessen;
CloseInput;
IF FromWB THEN
FOR i := 1 TO 9 DO DisplayBeep(NIL)
ELSE
BEGIN
WriteLn(#27"[1;33mFATALER FEHLER:");
WriteLn("KANN MEINEN HANDLER NICHT HINZUFÜGEN !!!!"#27"[0m");
END;
Halt(20);
END;
END;
{*********************************************************
** Vordefinieren der Variablen (Blanktime etc.). **
*********************************************************}
PROCEDURE DoVariables;
BEGIN
Linkshänder := FALSE;
prio := 57; { Priorität des input-Handlers }
blanked := FALSE; { Ist unser Blank-Screen aktiv ? }
MouseFactor := 3; { Beschleunigungs-Faktor }
ScreenTime := 180; { Zeit, die verstreichen muß, damit }
{ unser Blanker wach wird... }
MMBShift := FALSE;
blanknum := 1; { RANDOM-BLANKER }
shifted := FALSE;
lpressed := FALSE;
ThisTask := FindTask (Nil);
ScreenSwitcher := TRUE;
MTime := 5; { 5 Sek. bis zum Blanken der Maus. }
END;
{*********************************************************
** InputDevice etc. öffnen. **
*********************************************************}
FUNCTION OpenInput : BOOLEAN;
BEGIN
SigBit:=AllocSignal(-1);
IF SigBit<>-1 THEN
BEGIN
port := CreatePort (portname, 0);
IF port<>NIL THEN
BEGIN
ioreq := CreateStdIO (port);
IF ioreq<>NIL THEN
BEGIN
err:=OpenDevice("input.device",0,p_IORequest(ioreq),0);
IF err=0 THEN
OpenInput:=TRUE
ELSE
OpenInput:=FALSE;
END ELSE OpenInput:=FALSE;
END ELSE OpenInput:=FALSE;
END ELSE OpenInput:=FALSE;
END;
{*********************************************************
** Kleine Info beim CLI-Start. **
*********************************************************}
PROCEDURE GiveInfo;
BEGIN
WriteLn(#27"[1;33mMagicBlank V1.40"#27"[0m");
WriteLn;
WriteLn(#27"[1m©1993 by Björn Schotte (BOMBERSOFT)"#27"[0m");
WriteLn;
WriteLn("Programm kann mit CTRL-C abgebrochen werden !!");
WriteLn;
END;
{*********************************************************
** Das Kernstück des Programms: Der Input-Handler. **
** **
** Der Compiler darf den STACK NICHT PRÜFEN, da er **
** sonst fälschlicherweise einen Stacküberlauf fest- **
** stellen würde -> GURU !! **
*********************************************************}
{$opt b-,s-}
FUNCTION Handler (data: Ptr; event: p_InputEvent) : p_InputEvent;
CONST
HotKey = IEQUALIFIER_RALT;
VAR e2 : p_InputEvent;
p : LONG;
scr : p_Screen;
BEGIN
e2 := event;
{ Liste durchgehen }
WHILE e2 <> NIL DO
BEGIN
IF (e2^.ie_class AND IECLASS_TIMER)=IECLASS_TIMER THEN
BEGIN
IF MTime > 0 THEN
BEGIN
Dec(MouseTime);
IF (MouseTime <= 0) THEN
BEGIN
SPRITE_OFF;
cc.spr[0].dataa:=0;
cc.spr[0].datab:=0;
ResetMouseTime;
END;
END;
IF screentime > 0 THEN
BEGIN
Dec(zähler);
IF (zähler <= 0) AND (blanked = FALSE) THEN
BEGIN
ResetTime;
Signal(ThisTask,SBF_E);
END ELSE IF (zähler <= 0) AND (blanked = TRUE) THEN
ResetTime;
END;
END ELSE
IF ((e2^.ie_class AND IECLASS_RAWMOUSE)<>0) THEN
BEGIN
SPRITE_ON;
ResetMouseTime; { Mauszeit wieder zurückstellen. }
IF blanked THEN
{ Blanker beenden }
Signal(ThisTask,SBF_F);
ResetTime; { Zeit wieder neu einstellen }
IF MouseFactor > 0 THEN
Beschleuniger(e2,MouseFactor); { Maus beschleunigen }
IF Linkshänder = TRUE THEN
BEGIN
CASE e2^.ie_Code OF
IECODE_LBUTTON : e2^.ie_Code := IECODE_RBUTTON;
IECODE_LBUTTON+128: e2^.ie_Code := IECODE_RBUTTON+128;
IECODE_RBUTTON : e2^.ie_Code := IECODE_LBUTTON;
IECODE_RBUTTON+128: e2^.ie_Code := IECODE_LBUTTON+128;
ELSE END;
END;
IF (MMBShift = TRUE) THEN
BEGIN
CASE e2^.ie_Code OF
IECODE_LBUTTON: lpressed := TRUE;
IECODE_LBUTTON+128: lpressed := FALSE;
IECODE_MBUTTON:
IF lpressed THEN
BEGIN
shifted := TRUE;
e2^.ie_Class := IECLASS_RAWKEY;
e2^.ie_Code := 96;
END;
IECODE_MBUTTON+128:
IF shifted THEN
BEGIN
shifted := FALSE;
e2^.ie_Class := IECLASS_RAWKEY;
e2^.ie_Code := 224;
END;
ELSE END;
END;
IF (ScreenSwitcher = TRUE) THEN
BEGIN
CASE e2^.ie_Code OF
IECODE_MBUTTON:
BEGIN
p := LockIBase(0);
scr := IBase^.FirstScreen;
IF scr <> NIL THEN ScreenToBack(scr);
UnLockIBase(p);
END;
ELSE END;
END;
END ELSE
IF (e2^.ie_Class AND IECLASS_RAWKEY)<>0 THEN
BEGIN
SPRITE_OFF;
ResetTime;
Signal(ThisTask,SBF_F);
IF (e2^.ie_Code = 95) THEN
BEGIN
IF (e2^.ie_Qualifier AND HotKey) = HotKey THEN
BEGIN
SetKommando(COM_EDIT);
e2^.ie_Class := IECLASS_NULL;
Signal(ThisTask, mask);
END;
END;
END;
IF shifted THEN
e2^.ie_Qualifier := e2^.ie_Qualifier + IEQUALIFIER_LSHIFT;
e2 := e2^.ie_NextEvent { nächstes Element der Liste }
END; { OF WHILE }
Handler := event; { Zeiger auf alte Liste zurückgeben }
END;
{$opt s0}
PROCEDURE Usage;
VAR
dum : CHAR;
BEGIN
WriteLn;
WriteLn("MagicBlank V1.41 ©1993 by BOMBERSOFT");
WriteLn;
Write(CHR(27)+"[32m");
WriteLn("Dieses Programm darf NICHT verändert werden, außer");
WriteLn("auf privater Ebene. Dann muß mir aber der VERÄNDERTE");
WriteLn("Quelltext zugesandt werden !!");
WriteLn("MagicBlank darf auch auf anderen Serien veröffentlicht");
WriteLn("werden, aber OHNE Quellcode !!");
WriteLn;
WriteLn("Ein ABSOLUTES VERTRIEBSVERBOT gilt für:");
WriteLn;
WriteLn(" - OSSOWSKI");
WriteLn(" - WOLF");
WriteLn(" - INTERSOFT");
WriteLn(CHR(27)+"[0m");
WriteLn("Das Copyright bleibt also bei mir. Wer Vorschläge etc.");
WriteLn("hat, schreibt mir unter folgender Adresse:");
WriteLn;
WriteLn(" BJÖRN SCHOTTE");
WriteLn(" AM BURKARDSTUHL 45");
WriteLn(" 97267 HIMMELSTADT");
WriteLn;
Write("<RETURN> ");
ReadLn(dum);
WriteLn;
WriteLn;
WriteLn("USAGE:");
WriteLn;
WriteLn(" MagicBlank [-?] [-p|P<val>] [-m|M<1|0>] [-l|L<1|0>] [-s|S<1|0>]");
WriteLn(" [-f|F<val>] [-b|B<val>] [-t|T<val>] [-i|I<val>]");
WriteLn;
WriteLn;
WriteLn("MIT:");
WriteLn;
WriteLn("-p<val> : Handler-Priorität (Bsp.: -p57)");
WriteLn("-m<1|0> : m = 1 --> MMBShift aktiviert");
WriteLn(" m = 0 --> MMBShift deaktiviert");
WriteLn("-l<1|0> : l = 1 --> Maustasten vertauschen aktiviert");
WriteLn(" l = 0 --> Maustasten vertauschen deaktiviert");
WriteLn("-s<1|0> : s = 1 --> ScreenSwitcher aktiviert");
WriteLn(" s = 0 --> ScreenSwitcher deaktiviert");
WriteLn("-f<val> : Mausbeschleuinger-Faktor (bei 0 oder 1 DEAKTIVIERT)");
WriteLn("-b<val> : Blanknummer zwischen 1 (RANDOM) und 5");
WriteLn("-t<val> : Screenblanktime (Bsp.: -t180)");
WriteLn("-i<val> : Mausblanktime");
WriteLn;
Write(#27"[1;33m");
WriteLn("MagicBlank ist GIFTWARE. Hope you enjoy this program !!");
Write(#27"[0m");
HALT(0);
END;
{*********************************************************
** Kommandozeile auswerten. **
*********************************************************}
PROCEDURE VonCLI;
VAR
dum,fehler : INTEGER;
BEGIN
IF ParameterLen > 0 THEN
BEGIN
FOR i := 1 TO ArgNum DO
BEGIN
Arg[i] := GetArg(i);
IF Arg[i][1] = "-" THEN
BEGIN
CASE Arg[i][2] OF
"p","P":
BEGIN { Handler Priority }
Delete(Arg[i],1,2);
Val(Arg[i],dum,fehler);
IF fehler > 0 THEN Prio := 57
ELSE
BEGIN
IF dum IN [51..100] THEN Prio := dum ELSE Prio := 57;
END;
END;
"m","M": { MMBShift }
BEGIN
IF Arg[i][3]="1" THEN MMBShift := TRUE
ELSE MMBShift := FALSE;
END;
"l","L": { LeftyMouse }
BEGIN
IF Arg[i][3]="1" THEN Linkshänder := TRUE
ELSE Linkshänder := FALSE;
END;
"s","S": { ScreenSwitcher }
BEGIN
IF Arg[i][3]="1" THEN ScreenSwitcher := TRUE
ELSE ScreenSwitcher := FALSE;
END;
"f","F": { MouseFactor }
BEGIN
Delete(Arg[i],1,2);
Val(Arg[i],dum,fehler);
IF fehler>0 THEN MouseFactor := 3
ELSE
BEGIN
IF dum IN [0..9] THEN
BEGIN
IF dum=0 THEN dum := 1;
MouseFactor := dum;
END ELSE MouseFactor := 3;
END;
END;
"b","B":
BEGIN
Delete(Arg[i],1,2);
Val(Arg[i],dum,fehler);
IF fehler>0 THEN blanknum := 1
ELSE
BEGIN
IF dum IN [1..5] THEN blanknum := dum
ELSE blanknum := 1;
END;
END;
"t","T":
BEGIN
Delete(Arg[i],1,2);
Val(Arg[i],dum,fehler);
IF fehler>0 THEN ScreenTime := 180
ELSE ScreenTime := dum;
END;
"i","I":
BEGIN
Delete(Arg[i],1,2);
Val(Arg[i],dum,fehler);
IF fehler=0 THEN MTime := dum;
END;
"?" : Usage;
ELSE END;
END;
END;
END;
END;
{*********************************************************
** Das Hauptprogramm. **
*********************************************************}
BEGIN
IBase := IntuitionBase;
InterfaceCode :=
CodeTyp($48E7, $7F00, { MOVEM.L d1-d7,-(a7) }
$48E7, $00FE, { MOVEM.L a0-a6,-(a7) }
$4BF9, Addr(_paslibbase) shr 16,
Addr(_paslibbase)and$FFFF,{ LEA _paslibbase,a5 }
$4EB9, Addr(Handler) shr 16,
Addr(Handler) and $FFFF, { JSR Handler }
$4CDF, $7F00, { MOVEM.L (a7)+,a0-a6 }
$4CDF, $00FE, { MOVEM.L (a7)+,a1-a7 }
$4E75 { RTS }
);
port := FindPort(portname);
If port <> NIL Then
BEGIN
Signal(port^.mp_SigTask,SIGBREAKF_CTRL_C);
If FromWB Then
DisplayBeep(NIL)
ELSE
BEGIN
Writeln("MagicBlank beendet.");
Writeln;
END;
HALT(0);
END;
DoVariables;
IF NOT FromWB THEN VonCLI;
done:=OpenInput;
IF done THEN
BEGIN
ResetTime;
ResetMouseTime;
WITH inter, is_node DO
BEGIN
is_Code := ^InterfaceCode;
is_Data := NIL;
ln_Name := "MagicBlank-Handler";
ln_Pri := prio;
END;
mask := 1 SHL SigBit;
AddHandler;
GiveInfo;
done := FALSE;
REPEAT
sig:= _Wait(SBF_C or SBF_E or SBF_F or mask);
IF (sig and SBF_E)=SBF_E THEN
BEGIN
blanked := ScreenÖffnen;
IF blanked THEN
BEGIN
SPRITE_OFF;
cc.spr[0].dataa:=0;
cc.spr[0].datab:=0;
SetRGB4(^sp^.ViewPort,0, 0, 0, 0);
SetRGB4(^sp^.ViewPort,1, 6, 6, 6);
SetRGB4(^sp^.ViewPort,2,15, 0, 0);
SetRGB4(^sp^.ViewPort,3, 0,15, 0);
FOR i := 17 TO 19 DO SetRGB4(^sp^.ViewPort, i, 0, 0, 0);
weiter:
IF blanknum = 1 THEN
BEGIN
zuf := Random(3);
Case zuf of
0 : Points;
1 : Lines;
2 : Stars;
ELSE END;
END ELSE
BEGIN
CASE BlankNum OF
2 : Stars;
3 : Points;
4 : Lines;
5 : BlackScreen;
ELSE END;
END;
If sig1 = 0 then goto weiter;
Schliessen;
blanked := FALSE;
ResetTime;
END;
END ELSE
IF (sig and SBF_C)=SBF_C THEN
BEGIN
done:=TRUE;
END ELSE
IF (sig AND mask) = mask THEN
BEGIN
{ Spätere Erweiterungen !! }
i := Kommando;
ClearKommando;
CASE i OF
COM_EDIT : {};
ELSE END;
END;
UNTIL done = TRUE;
RemHandler;
Schliessen;
SPRITE_ON;
END;
CloseInput;
END.